perm filename SCMSS.OLD[XX,LCS] blob
sn#217896 filedate 1976-05-30 generic text, type T, neo UTF8
00010 C****** SCMSS, LNEND *********** 12/1/75
00100 SUBROUTINE SCMSS
00110 COMMON /PLTR/PLT,RHT,DIS/PTR/KWDS(250),ITEM,LL,IS,IX
00300 COMMON R2,JA,G,H,R3,U(39)/SCM/V(78),I,LCNT,STAFF,JLIST(200),REND
00350 C JLIST WILL SOMETIMES BE USED(WIPED OUT) FOR R(X,Y) OVERFLOW(>50 ITEMS.)
00500 DIMENSION RLIST(200),NOMOR(6),WARN(6),R(10,80),ISV(5)
00550 C /SCX/ ALSO IN WORDS, NEWR
00600 COMMON/SCX/RHY(4),JALPHA(30),RB,RC,JZ,IRHY,JD,KA,KB,IZ
00610 1/STF/RSTFAC(8),RSTJ2/FRMT/F78F(1),FA1(1),FA5(1),IREAD
00700 1/XRN/RN(4000) /ALF/INP(72),ML
00800 COMMON /SC/J,L,MK,ISKP,XMINUS,N,IEXP,LK,NNUM,JJ,JN,DBST
00900 1,NFLG,IXX,ISEMI,JG,VX(50),IAMP,K,KN,M,MODE,IBLA
01100 EQUIVALENCE (VX1,VX(1)),(INP1,INP(1)),(VX2,VX(2)),(VX3,VX(3)),
01200 1(VX4,VX(4)),(VX5,VX(5)),(JLIST,RLIST),(R,RN(3001)),(INP1,INP(1))
01300 1 ,(INP2,INP(2)),(INP3,INP(3)),(INP4,INP(4)),(IBEAM,RN(3000))
01400 1,(ISTAR,JALPHA(8)),(ICOL,JALPHA(9)),(IRP,JALPHA(6)),
01410 1(ILP,JALPHA(5)),(NEG,JALPHA(2)),(IAT,JALPHA(16)),(IDOT,
01455 1JALPHA(3)),(RMODE2,RN(3918)),(SET4,RN(3920)),(NOSET,RN(3923))
01500 DATA KSLA/'/'/,IXX/'X'/,LCNT/1/,RHY/.5,.25,.125,.0625/
01600 1,ISEMI/';'/,IBLA/' '/
01700 ISX=IS
01800 C SAVE RN COUNTER FOR ZERO FEATURE AT 168
01900 1177 IF(JA.EQ.14)GO TO 77
01950 IF(JA.NE.144)GO TO 11
02000 77 MODE=1
02050 CC THIS IS SET IN MSX NOW **** RMODE2=R3
02060 TYPE 444,SET4
02100 IBEAM=-1
02200 IZ=0
02300 IREAD=0
02400 11 IF(IREAD)GO TO 2304
02500 IF(JA.NE.144)GO TO (1,2,3,4,5,69)MODE
02700 2302 IF(IREAD)GO TO 2304
02705 REREAD 80052,L,L,L,STAFF,RMODE2
02707 GO TO 2177
02708 2304 IF(IREAD.EQ.-1)REREAD 21141,L,INP
02709 IF(IREAD.EQ.-2)REREAD 2114,INP
02710 2303 TYPE 80053
02800 ACCEPT 80052,STAFF
02810 CC IF(STAFF.NE.444)GO TO 2177
02820 REREAD 4177,RA,RB
02825 IF(RA.NE.'SP')GO TO 4177
02830 C NOW SPACER CAN BE SET AT THIS POINT
02835 SET4=RB
02840 GO TO 2303
02845 4177 FORMAT(A2,F)
02847 TYPE 8009,MODE,INP
02850 2177 IF(STAFF.GE.99)GO TO 690
02875 C TYPE 99 OR 999 TO ESCAPE WHEN IN READ-IN MODE
02887 REND=0
02900 IF(IREAD)GO TO 80041
02950 IF(LOOK(L)+LOOKD(L))GO TO 101
02960 TYPE 101,L
02970 GO TO 690
02980 101 FORMAT(' FILE NOT FOUND - ',A5)
03000 IREAD=-1
03055 C FOR 1ST TIME IN BEAMS.
03100 REWIND 22
03200 CALL IFILE(22,L)
03220 2301 IF(IREAD.EQ.-2)GO TO 2307
03300 READ(22,21141,END=68),L,INP
03305 IF(L.NE.0)GO TO 2300
03307 C JUMP IF LINE NUMBERS
03310 IF(INP1.EQ.'O')GO TO 2307
03320 IREAD=-2
03325 C THIS IS FOR NON-'ET' FILES WITH NO LINE NUMBS.
03330 REREAD 2114,INP
03332 GO TO 2300
03335 2307 READ(22,2114,END=68)INP
03340 IF(IREAD.EQ.-2)GO TO 2300
03345 IF(INP3.NE.ISEMI)GO TO 2307
03350 IREAD=-2
03352 READ(22,2114)INP
03355 GO TO 2307
03400 2300 IF(MODE.EQ.6)GO TO 1111
03500 IF(INP1.EQ.IBLA)GO TO 8006
03600 IF(INP1.EQ.ISEMI)GO TO 8006
03625 C 'ET' FILES MUST HAVE ';' AS 1ST CHAR. BLANK LINES ARE IGNORED!!
03637 TYPE 8009,MODE,INP
03650 GO TO 6177
03700 1111 MODE=1
03800 REND=2
03900 IZ=0
04000 CC RETURN
04200 C ABOVE ALLOWS MORE STAVES TO BE READ
04220 168 IF(NOSET.EQ.0)RETURN
04262 L=ISX
04280 2168 RA=RN(L+1)
04290 IF(RA.EQ.1)GO TO 3168
04300 IF(RA.NE.2)GO TO 1168
04340 N=7
04350 GO TO 4168
04352 3168 IF(RN(L).LT.7)GO TO 1168
04354 C SKIP NOTES SANS RHYTH. (CHORD NOTES.)
04356 N=9
04360 4168 RN(L+N)=0
04380 C ZEROS RHYTHM OF ADDED INPUT ON SPACING STAFF
04402 1168 L=L+RN(L)+3
04404 IF(L.LT.IS)GO TO 2168
04420 RETURN
04780
04800 80053 FORMAT(' NEXT STAFF NUM='$)
05000 80052 FORMAT(F,A4,A5,2F)
05010 444 FORMAT(' SPACING STAFF =',F3.0)
05100
05400 4 TYPE 8002
05500 CC330 ACCEPT 2114,N,L,INP3,INP4
05550 330 ACCEPT 2114,INP
05650 IF(INP1.EQ.'G')GO TO 69
05700 C TYPE 'GO' TO PASS LATER ITEMS
05800 IF(INP1.EQ.'9')GO TO 99
05850 IF(INP1.EQ.'B')GO TO 99
05900 IF(INP1.EQ.'Y')GO TO 1
05925 IF(INP2.EQ.'B')GO TO 134
05931 IF(INP3.EQ.'B')GO TO 134
05937 C FOR BEAMS? TYPE 'nB' INSTEAD OF 'Y' FOR AUTOMATIC.
05950 IF(INP1.EQ.'N')GO TO 2000
05962 IF(INP1.NE.IBLA)GO TO 11
05975 C PICKS UP TYPOS
06000 2000 MODE=MODE+1
06050 WRITE(21,2114)INP4
06100 GO TO 11
06130 691 FORMAT(' INPUT SAVED ON FOR21.DAT')
06140 69 END FILE 21
06145 TYPE 691
06150 690 REND=1
06175 CC RETURN
06187 GO TO 168
06200 3 TYPE 8023
06300 GO TO 330
06400 5 TYPE 8022
06500 GO TO 330
07300
07400 8006 MODE=MODE+1
07410 IF(MODE.NE.2)GO TO 177
07415 IF(RMODE2.EQ.2)GO TO 80041
07420 C FOR NEW INPUT FORMAT -- TYPE 14 2 OR 144 -2 ETC.
07500 177 IF(IREAD)GO TO 2301
07600 IF(MODE.LE.5)RETURN
07620 END FILE 21
07660 TYPE 691
07700 68 REND=-1
07750 CC RETURN
07850 GO TO 168
07900
09000 99 IF(INP3.EQ.'9')GO TO 999
09200 C ELSE GET ANOTHER CHANCE TO SAY 'NO'. 99=BACKUP, 999=ESCAPE
09400 MODE=MODE-1
09600 IF(MODE.EQ.0)GO TO 999
09610 IS=ISV(MODE)
09620 GO TO 11
09650 C INSERT BACKUP ROUTINE
09700 999 REND=99
09800 RETURN
10550 C FIX BACKUPS********
10600
10800 8008 FORMAT(' TYPE ',I2,' RHYTHMS')
10900 8002 FORMAT(' ADD BEAMS? '$)
11000 8022 FORMAT(' ADD SLURS? '$)
11100 8023 FORMAT(' ADD MARKS? '$)
11110 8009 FORMAT(I2,4X,72A1)
11200 8011 FORMAT(1XI3,' MORE RHYTHMS NEEDED'/)
11210 8015 K=IRHY-I+1
11400 TYPE 8011,K
11500 IF(IREAD)IREAD=-IREAD
11550 C ↑↑↑↑↑ SO YOU CAN TYPE MORE LINES WHEN ERROR ON READIN.
11600 2 TYPE 8008,IRHY
12000
12350 1 ISV(MODE)=IS
12400 CALL TYPE
12410 REREAD 4177,RA,RB
12420 IF(RA.NE.'SP')GO TO 5177
12430 SET4=RB
12440 C CAN SET SPACER HERE
12450 GO TO 1177
12600 5177 IF(INP1.EQ.IBLA) GO TO 1
12700 IF(INP1.NE.'9')GO TO 80041
12750 IF(INP2.EQ.'9')GO TO 99
12800 C TYPE '99' TO BACK-UP
12850 80041 WRITE(21,2114)INP
12875 6177 CALL LNEND
12900 IF(MODE.GE.3)GO TO 133
13100 RETRO=-1.
13200 I=1
13300 PARENS=0
13400 MOT=0
13500 JZ=1
13600 IAMP=0
13700 C IAMP IS 'BLANK LINE'FLAG ON PP1-3.
13800 KL=0
13900 RA=0
14000 2408 MLX=1
14100 L=-1
14110 IF(RMODE2.EQ.2)CALL PRESCN
14120 C GO SORT OUT THE NEW FORMAT
14200 DO 2999 K=1,72
14300 N=INP(K)
14400 IF(N.EQ.IBLA)GO TO 2999
14500 L=0
14600 IF(N.EQ.ISTAR)GO TO 277
14650 IF(N.NE.ISEMI)GO TO 2999
14700 C READS 72 CHARS. INCLUDING *.
14800 277 INP(K+1)=ISEMI
14900 GO TO 1773
15000 C --- X/Y/Z* --- WITH NO SEMICOLON WORKS FOR THIS PROG. ONLY!
15100 2999 CONTINUE
15200 IF(IREAD)GO TO 8015
15210 TYPE 6999
15220 GO TO 1
15230 6999 FORMAT(' ****** TRY AGAIN ***** ')
15300 CC GO TO 69
15400 C ERROR IF NO '*' OR ';' AT END OF LINE.
15500
15600 1299 IF(JZ.NE.0)GO TO 1773
15610 7773 IF(MODE.NE.2)GO TO 377
15632 IF(RMODE2.EQ.2)GO TO 77732
15655 C ↑↑↑↑↑↑ FOR NEW INPUT FORMAT
15700 377 IF(IREAD.EQ.0)GO TO 77731
15800 C BYPASS IF NOT USING EDIT FILE
15900 IF(IREAD.EQ.-1)READ(22,21141),L,INP
15910 IF(IREAD.EQ.-2)READ(22,2114)INP
16000 C TO READ 2ND LINE OF NOTE INPUT, IF NEEDED
16010 TYPE 8009,MODE,INP
16100 GO TO 77732
16300 77731 CALL TYPE
16350
16400 IF(INP1.EQ.IBLA)GO TO 7773
16451 WRITE(21,2114)INP
16475 77732 CALL LNEND
16500 JM=-1
16600 JZ=0
16700 GO TO 2408
16800 C 'LISTS' MUST END WITH *
16900 1773 JZ=0
17000 DBST=1.
17020 IF(XDBST)DBST=-DBST
17040 XDBST=0
17100 17731 ML=MLX
17200 IF(PARENS.LE.0.)GO TO 975
17300 C PARENS=-1, OPENS; =1, CLOSES; =0, NONE
17400 3362 PARENS=0
17500 MOT=I-LMOT
17600 IF(LCNT+MOT.LT.198)GO TO 33621
17700 DATA NOMOR/30H(' NO ROOM FOR MOTIVE ',A1/) /
17800 TYPE NOMOR,JMOT
17900 GO TO 1
18000 33621 JLIST(LCNT+1)=MOT
18100 LCNT=LCNT+2
18200 DO 2140 JG=0,MOT-1
18300 2140 RLIST(LCNT+JG)=V(LMOT+JG)
18400 LCNT=LCNT+MOT
18500 IF(IAMP)GO TO 3013
18700 C FOR CLOSE PARENS ON LAST ITEM
18800 C STORE MOTIVE IN RLIST ARRAY
18900
19000 975 DO 236 JDD=ML,72
19100 JD=JDD
19200 N=INP(JD)
19300 C ((((())))) MAY 13,71 /Z (D4/E/X 2 3/) CS/ ETC. CAN USE 26 LABELS.
19400 IF(N.EQ.ILP)GO TO 477
19450 IF(N.EQ.IRP)GO TO 477
19475 IF(N.NE.ICOL)GO TO 2361
19500 477 INP(JD)=IBLA
19600 IF(N.NE.ICOL)GO TO 1113
19720 XDBST=-1.
19740 GO TO 5362
19750 C GO CHANGE IT TO A SEMIC. !!! CAN'T END LINE WITH :
19760 C SO NXT NOTE WILL BE DBST (TYPE /F:A:C/ ETC.)
19860 C DBSTS WILL BE ONLY ONE 'REP' UNIT X*0Z%~#&@
20000 1113 L=JD-1
20100 5113 IF(INP(L).NE.IBLA)GO TO 2113
20200 L=L-1
20300 GO TO 5113
20400 2113 IF(N.EQ.')')GO TO 3361
20500 C ONLY ONE () AS YET, NO NESTING
20600 1140 JMOT=INP(L)
20700 C MOTIVE NAME
20800 DO 11401 JC=1,LCNT-1
20900 IF(JMOT.NE.JLIST(JC))GO TO 11401
21000 C FINDS DUPLICATE IDENTIFIER
21200 11402 FORMAT(' MOTIVIC (',A1,') USED TWICE')
21400 TYPE 11402,JMOT
21450 JLIST(JC)=0
21475 C ZERO OUT PREVIOUS USE OF IDENTIFIER.
21500 11401 CONTINUE
21600 JLIST(LCNT)=JMOT
21700 PARENS=-1.
21800 C A PARENTH IS OPEN
21900 INP(L)=IBLA
22000 LMOT=I
22100 C LMOT IS CURRENT POINT IN V ARRAY
22200 GO TO 236
22300 3361 IF(PARENS.NE.0)GO TO 33612
22400 DATA WARN/30H(' PARENTH ERROR - GOING ON'/)/
22500 TYPE WARN
22600 33611 INP(JD)=IBLA
22700 GO TO 236
22800 33612 PARENS=1.
22900 C SETS PARENS CLOSED FLAG
23000 GO TO 33611
23100 C NO INVERSIONS POSSIBLE NOW
23200 2361 IF(N.NE.IAT)GO TO 5361
23300 DO 113 L=1,72
23400 K=JD+L
23500 C K IS USED AT 240!!!
23600 JG=INP(K)
23700 IF(JG.NE.NEG)GO TO 7113
23800 RETRO=0
23900 INP(K)=IBLA
24000 GO TO 113
24100 7113 IF(JG.NE.IBLA)GO TO 4113
24200 113 CONTINUE
24300 4113 DO 6361 L=1,LCNT
24400 IF(JG.NE.JLIST(L))GO TO 6361
24500 VX1=0
24600 DO 40 M=JD+2,72
24700 JG=INP(M)
24800 IF(JG.EQ.IBLA)GO TO 40
24900 IF(JG.EQ.KSLA)GO TO 140
24950 IF(JG.EQ.ISEMI)GO TO 140
24975 IF(JG.EQ.ISTAR)GO TO 140
25000 ML=M
25100 GO TO 240
25200 40 CONTINUE
25300 240 JC=JM
25400 JM=-1
25500 INP(K)=IBLA
25600 JN=0
25700 C MUST BE ZERO IN SCANR
25800 CALL SCANR
25900 JM=JC
26000 140 JC=1
26100 KN=L+2
26210 M=KN+JLIST(L+1)
26300 IF(RETRO)GO TO 940
26400 KN=M-1
26550 M=L+1
26600 JC=-1
26700 RETRO=-1.
26800
26900 940 Z=RLIST(KN)
27000 IF(VX1.EQ.0)GO TO 540
27100 C " @Q N " WHERE N= 1/2 STEPS IN 'NOTES' OR MULT FACTOR IN OTHERS.
27200 IF(MODE.EQ.1)GO TO 440
27300 C MODE 1 IS NOTES, 2 IS RHY.
27400 V(I)=Z*VX1
27500 GO TO 7361
27600 440 IF(Z.EQ.85.)GO TO 540
27605 RB=VX1
27610 IF(Z)RB=-RB
27620 C NOW TRANSPOSES BY DIAT. STEPS ONLY 1000S=FLAT, 10000S=SHARP, 100000S=NAT
27630 C NEG NUMS ARE CHORD NOTES.
27700 V(I)=Z+RB
27800 GO TO 7361
27900 540 V(I)=Z
28000 7361 I=I+1
28100 KN=KN+JC
28200 IF(KN.NE.M)GO TO 940
28300
28400 RB=V(I-1)
28600 DO 8361 L=JD,72
28700 JG=INP(L)
28800 INP(L)=IBLA
28900 IF(JG.EQ.KSLA)GO TO 9361
29000 IF(JG.EQ.ISEMI)GO TO 93611
29200 8361 IF(JG.EQ.ISTAR)IAMP=-1
29300 9361 MLX=L
29400 IF(IAMP.EQ.0)GO TO 17731
29600 JZ=-1
29700 93611 IF(IAMP)GO TO 3013
29900 GO TO 7773
30000 6361 CONTINUE
30100 TYPE 6362,JG
30200 GO TO 11402
30300 6362 FORMAT(' MOTIVIC (',A1,') NOT FOUND')
30400 C @@@@@@@@@@@@@@@@@@@@@@@@@@
30500 5361 IF(N.NE.KSLA)GO TO 636
30600 5362 MLX=JD+1
30700 JZ=-1
30800 INP(JD)=ISEMI
30900 436 IF(INP(MLX).NE.IBLA)GO TO 103
31000 MLX=MLX+1
31100 GO TO 436
31200 636 IF(N.EQ.ISEMI)GO TO 103
31300 936 IF(N.NE.IDOT)GO TO 736
31400 L=INP(JD+1)
31500 KL=NALF(L)
31600 IF(L.LE.0)GO TO 577
31650 IF(KL.LT.0)GO TO 577
31675 IF(KL.LE.9)GO TO 236
31700 C JUMP IF IT'S A NUMBER
31800 577 IF(MODE.EQ.2)INP(JD)=1
31900 C :::::::::******* ↑↑↑↑ MODE #?
32000 GO TO 236
32100 C CHANGES DOTTED RHYTHMS TO '1'S.
32200 736 IF(N.NE.ISTAR)GO TO 236
32300 IAMP=-1
32400 INP(JD)=ISEMI
32600 GO TO 103
32700 236 CONTINUE
00100 2114 FORMAT(72A1)
00200 21141 FORMAT(I,72A1)
00300
00400 5016 IF(IAMP.GE.0)GO TO 1299
00500 IF(PARENS.NE.0)GO TO 3362
00600 C PARENS ARE STILL OPEN?
00700 GO TO 3013
00800 103 K=INP(ML)
00900
01000 C LAST SECTION
01100 IF(K.EQ.ISEMI)GO TO 1014
01200 C*********** MODE #?
01300 IF(K.NE.IBLA) GO TO 1899
01400 ML=ML+1
01500 GO TO 103
01600 1899 JN=0
01700 C MUST BE ZERO IN SCANR
01800 VX4=0
01900 NOAC=0
02000 CALL SCANR
02100 IF(VX1.EQ.-99.)GO TO 4022
02200 IF(MODE.NE.2)GO TO 17
02300 C*********** MODE #?
02400 2017 IF(VX1.EQ.10000.)GO TO 17
02500 VX1=4./VX1
02600 IF(JJ.NE.1)GO TO 2014
02700 V(I)=VX1
02800 GO TO 114
02900 2014 DO 9006 L=2,JJ
03000 IF(VX(L).EQ.0)GO TO 17
03100 9006 VX1=4./VX(L)+VX1
03200 JJ=1
03300 17 V(I)=VX1
03400 IF(VX4.EQ.0)GO TO 115
03500 IF(MODE.NE.1)GO TO 115
03600 C NEXT FOR AUTO-OCTAVES AND OTHER INTERVALS. (/AS4+3/= /AS4:DS5/ ETC.
03700 CC RB=7
03800 CC IF(VX4.EQ.'-')RB=-RB
03900 I=I+1
04000 CC V(I)=-VX1-RB
04050 V(I)=-ABS(VX1)-VX4
04100 115 IF(JJ.LE.1)GO TO 114
04200 IF(MODE.NE.1)GO TO 171
04300 IF(VX2.EQ.0)GO TO 171
04400 C JUMP IF RHY OR 'X 4' ETC.
04500 V(I)=-(VX1/100.+VX2/10000.)
04600 C PACKS 2 METER NUMS INTO ONE SLOT (-.1208 = 12/8)
04700 114 I=I+1
04800 CA IF(VX3.EQ.0)GO TO 5016
04900 CA IF(MODE.NE.1)GO TO 5016
05000 C NEXT FOR AUTO-OCTAVES (VX3.NE.0 WITH DOUBLE-DOTTED RHYTHS.)
05100 CA VX2=7.
05200 C IF(VX3.EQ.'-')VX2=-7
05300 CA V(I)=-(VX1+VX2)
05400 C '-V' MAKES CHORD
05500 CA I=I+1
05600 GO TO 5016
05700 171 JC=1
05800 JD=VX(JJ)-1
05900 I=I+1
06000 GO TO 5005
06100 1014 JD=1
06200 JC=1
06300 C X4/ CREATES REP 1,4; A/// CREATES REP 1,3;
06400 GO TO 5005
06500 4022 JC=VX2+.3
06600 JD=VX3-.5
06700 IF(JJ.EQ.2)JD=1
06800 C JD=HOW MANY TIMES, JC=HOW MANY NOTES
06900 5005 N=0
07000 DO 3005 K=I-1,1,-1
07100 IF(V(K).GT.0)N=N+1
07200 3005 IF(N.EQ.JC)GO TO 4005
07220 4005 IF(JC.GT.1)GO TO 7005
07240 IF(MODE.EQ.1)NOAC=-1
07260 C 5/76 ******* AF/// WILL CREATE AF/A//-- AN:FS/// = AN:FS/A:F// *******
07280 C ACCIS ARE DROPPED WITH / OR Xn REPEAT. (BUT NOT WITH 'REP' OR '/X n,n/')
07300 7005 JC=I-K
07400 C ALL THIS IS TO FIND COMPLETE CHORDS, BARS, ETC. TO REPEAT.
07500 C REPS WILL ONLY COUNT RHYTHMIC UNITS.!
08000 DO 1005 K=1,JD
08100 NL=I+JC-1
08200 DO 2005 L=I,NL
08300 KN=L-JC
08400 IF(NOAC)GO TO 6005
08500 V(L)=V(KN)
08600 GO TO 2005
08700 6005 V(L)=AMOD(V(KN),1000.0)
08800 C DROPS ACCIS WHEN SLASH REP. OR 'X' IS USED.
08900 2005 CONTINUE
09000 1005 I=I+JC
09100 GO TO 5016
09200
09300 3013 IF(MODE.NE.2)GO TO 771
09400 IF(I-1.NE.IRHY)GO TO 8015
09500 C WRONG NUMBER OF ITEMS
09600 771 V(I)=-99.
09700 IF(MODE.NE.1)GO TO 132
09800 CCC NIT=ITEM+1
09900 C FOR ADDED NOTES ON SPACING STAFF
10000 CALL NOTES
10100 CCC JIT=IZ
10200 C SAVES TOTAL OF ITEMS FOR LABEL 168
10300 67 CALL NEWR
10400 GO TO 8006
10500 132 IF(IREAD.GT.0)IREAD=-IREAD
10600 CALL RHYTH
10700 C =50 IS RHYTHM FOR TEXT
10800 GO TO 67
10900 CC134 WRITE(21,2114)N,L,INP3
11000 CC INP3='B'
11100 CC INP2=0
11150 134 WRITE(21,2114)INP
11175 C WRITES TYPED IN REPLY TO 'ADD BEAMS?'
11200 C ACCENTS ARE IN BEAMS SUBROUTINE
11300 133 CALL BEAMS
11400 IF(MODE.EQ.3)GO TO 135
11500 IF(MODE.EQ.4)IBEAM=0
11600 C ADJUSTS STEMS (IBEAM=0) IF BEAMS WERE ENTERED.
11700 GO TO 8006
11800 135 K=IS
11900 CALL NEWR
12000 IS=K
12100 C ↑↑↑↑↑↑ TO ADD NEW ITEMS, SUCH AS PPP, MP, CRESC., ETC.(SEE 'MARKS')
12200 GO TO 8006
12300 END